perm filename PARSER.SAI[PUB,TES] blob
sn#073669 filedate 1974-03-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 ENTRY MANUSCRIPT
C00006 00003 INTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL)
C00013 00004 INTERNAL SIMPLE PROCEDURE RDENTITY
C00016 00005 ELSE
C00018 00006 INTEGER SIMPLE PROCEDURE ESTIMATE
C00023 00007 INTERNAL RECURSIVE STRING PROCEDURE PASS comment Value is always NULL
C00027 00008 ie 6 ... reserved word IF IX=IXCOMMENT∧ ¬DCLR_ID THEN
C00030 00009 WHILE ITSCH(",") DO
C00032 00010 INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD)
C00036 00011 COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , and ↑ ) are combined
C00040 00012 WHILE THISTYPE=-BROKQ DO ie Substring Specifications
C00045 00013 STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE INTEGER ARGS, IBASE)
C00051 00014 RECURSIVE PROCEDURE PARAMS(INTEGER MOST STRING ARRAY PRE,PAR,POST)
C00054 00015 SIMPLE PROCEDURE FINPORTION
C00057 00016 SIMPLE PROCEDURE DBELOW
C00061 00017 RECURSIVE PROCEDURE DCONDITIONAL
C00065 00018 INTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH)
C00068 00019 RECURSIVE PROCEDURE DFRAME(BOOLEAN BOXFRM)
C00070 00020 SIMPLE PROCEDURE DINSERT
C00073 00021 SIMPLE PROCEDURE DLOCAL
C00076 00022 SIMPLE PROCEDURE DMARGINS(BOOLEAN INWARD)
C00079 00023 SIMPLE PROCEDURE DPORTION
C00082 00024 SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD)
C00085 00025 CASE VARI-1 MIN 2 OF
C00088 00026 ie 3,4... AFTER/BEFORE area|unit
C00091 00027 SIMPLE PROCEDURE DSKIP(BOOLEAN GRPSKIP)
C00095 00028 INTEGER SIMPLE PROCEDURE COUNTERSTMT
C00098 00029 RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT
C00099 00030 RECURSIVE BOOLEAN PROCEDURE COMMAND
C00102 00031 ie NARROW DMARGINS(1) COMMENT SEMI-OBSOLETE
C00104 00032 INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID)
C00106 ENDMK
C⊗;
ENTRY MANUSCRIPT ;
BEGIN "PARSER"
DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
REQUIRE "PUBDFS.SAI" SOURCE_FILE ;
REQUIRE "PUBMAI.SAI" SOURCE_FILE ;
BEGIN "INNER BLOCK"
REQUIRE "PUBINR.SAI" SOURCE_FILE ;
REQUIRE "PUBPRO.SAI" SOURCE_FILE ;
EXTERNAL INTEGER PROCEDURE XLENGTH(STRING S);
EXTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
EXTERNAL RECURSIVE PROCEDURE DBREAK ;
EXTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
FORWARD INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
FORWARD INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
IFC TENEX THENC
STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
BEGIN
INTEGER DUMMY ;
SETBREAK(LOCAL_TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
RETURN(SCAN(SCANNEE, LOCAL_TABLE, DUMMY)) ;
END ;
STRING SIMPLE PROCEDURE CVFIL(STRING FILENAME; REFERENCE STRING EXT, PPN) ;
BEGIN
STRING NAME ;
PPN ← IF FILENAME[1 FOR 1] = "<" THEN SCANTO(">", FILENAME, TRUE) ELSE NULL ;
NAME ← SCANTO(".;", FILENAME, FALSE) ;
EXT ← IF FILENAME[1 FOR 1] = "." THEN SCANTO(";", FILENAME, FALSE) ELSE NULL ;
RETURN(NAME) ;
END ;
ENDC
INTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
BEGIN
COMMENT INPUTSTR = [ [chars] LF line-no TB ]... [chars]
All break tables should break on LF.
RD's value is as if LF line-no TB were null. ;
INTEGER PTR, BYTEWD ; STRING SPTR, RESULT, PART ;
RESULT ← NULL ;
DO BEGIN "PARTIAL"
PART ← SCAN(INPUTSTR, BRKTBL, BRC) ;
IF BRC = LF THEN
BEGIN "MACRO LINE NUMBER"
MACLINE ← SCAN(INPUTSTR, TO_TB_FF_SKIP, DUMMY) ;
IF PART[∞ FOR 1] = LF THEN comment he Appended the break character ;
PART ← IF DEFINING THEN PART & MACLINE & TB ELSE PART[1 TO ∞-1]
ELSE IF DEFINING THEN PART ← PART & LF & MACLINE & TB ;
END "MACRO LINE NUMBER"
ELSE IF BRC = 0 THEN comment, ran out of input ;
IF INPUTCHAN < 0 THEN INPUTSTR ← SWICHBACK comment, done scanning macro body ;
ELSE BEGIN "FROM FILE"
DO BEGIN comment, may be page marks or eof or more lines ;
IF TECOFILE THEN
BEGIN COMMENT CHECK FOR FF AND SUPERFLUOUS LFs ;
SRCLINE ← CVS(CVD(SRCLINE)+1) ;
INPUT(INPUTCHAN, NO_CHARS) ;
WHILE BRC = LF DO
BEGIN
INPUT(INPUTCHAN,ONE_CHAR) ;
INPUT(INPUTCHAN,NO_CHARS) ;
END ;
END
ELSE SRCLINE ← INPUT(INPUTCHAN, TO_TB_FF_SKIP) ;
IF BRC = FF THEN
BEGIN "PGMARK"
PAGEMARKS ← PAGEMARKS + 1 ;
IF TECOFILE THEN
BEGIN
INPUT(INPUTCHAN, ONE_CHAR) ;
SRCLINE ← "0" ;
END ;
WHILE INPGS ∧ LAST=4 ∧ BRC=FF ∧ PAGEMARKS>RH(INPG[INPGX]) DO
IF (INPGX←INPGX+1)>INPGS THEN BEGIN BRC←0 ; EOF←1 END
ELSE IF PAGEMARKS<(K←LH(INPG[INPGX])) THEN
DO BEGIN "SKIP PAGES"
DO INPUT(INPUTCHAN,TO_LF_TB_VT_SKIP)
UNTIL BRC≠TB;
IF BRC = LF THEN
DO BEGIN
SRCLINE←INPUT(INPUTCHAN,TO_TB_FF_SKIP);
IF BRC=FF THEN PAGEMARKS←PAGEMARKS+1 ;
END UNTIL BRC≠FF ;
END "SKIP PAGES"
UNTIL BRC≠TB ∨ PAGEMARKS ≥ K ;
IF ¬EOF THEN
BEGIN COMMENT COMPUTE AND DISPLAY PAGE NUMBER ;
SRCPAGE ← CVS(PAGEMARKS) ;
IF NOT PUBSTD THEN OUTSTR((
IF SWDBACK<0 THEN CRLF&SPS(LAST)
ELSE IF SWDBACK>0 THEN SPS(LAST)
ELSE SP
)&SRCPAGE) ;
SWDBACK ← 0 ;
END ;
END "PGMARK" ;
END
UNTIL BRC ≠ FF ;
MACLINE ← NULL ;
IF FULSTR(LSTOP) ∧ EQU(ERRLINE&"/"&SRCPAGE, LSTOP) THEN
BEGIN
DARN(NULL,VS(THISWD)&VS(THATWD)&VS(INPUTSTR)&CRLF&
VS(OWL[1 TO OAKS])&CRLF&VI(POSN)&VI(BRC)&VI(BRKTBL)) ;
S ← INCHWL ; LSTOP←("0000"&SCAN(S,DIGITA,DUMMY))[∞-4 FOR 5]&S ;
END ;
IF EOF THEN INPUTSTR ← SWICHBACK comment, done scanning a SOURCE_FILE or gen-file;
ELSE BEGIN "FILE LINE"
DO BEGIN "EXPAND TABS"
INPUTSTR ← INPUTSTR & INPUT(INPUTCHAN,TO_LF_TB_VT_SKIP) ;
IF BRC=TB THEN INPUTSTR←INPUTSTR&
(IF PAGESCAN(LAST)≥0 THEN
IF TABTAB=0 THEN
SPS(8-LENGTH(INPUTSTR) MOD 8)
ELSE TABTAB
ELSE TB)
ELSE IF BRC=VT THEN
IF INPUTSTR[∞ FOR 1]=RCBRAK THEN INPUTSTR←INPUTSTR&VT
ELSE
BEGIN "GENVT" COMMENT MAYBE {PAGE!} IN GEN-FILE ;
SPTR ← INPUT(INPUTCHAN, TO_VT_SKIP) ;
IF (PTR ← CVD(SPTR)) ≥ TWO(14)
AND LDB(PLIGHTWD("BYTEWD←ITBL[PTR-TWO(14)]"))=2
THEN
BEGIN
BREAKSET(LOCAL_TABLE,ALTMODE,"IS");
BREAKSET(LOCAL_TABLE,NULL,"O");
S ← STBL[LDB(IXWD(BYTEWD))] ;
INPUTSTR ← INPUTSTR[1 TO ∞-6] &
SCAN(S,LOCAL_TABLE,DUMMY);
END
ELSE INPUTSTR ← INPUTSTR & VT & SPTR & VT ;
END "GENVT"
END "EXPAND TABS"
UNTIL BRC = LF ∨ BRC < 0 ∨ EOF ;
IF BRC≤0 THEN
BEGIN BRC ← LF ;
IF ¬EOF THEN
WARN("=","GARBAGED MANUSCRIPT "&ERRLINE&"/"&SRCPAGE)
END ;
IF DEFINING THEN PART ← PART & LF & SRCLINE & "/" & SRCPAGE & TB ;
END "FILE LINE" ;
END "FROM FILE" ;
IF BRC = LF THEN
IF DEFINING THEN BEGIN BRC←0 ; IF INPUTSTR=COMMAND_CHARACTER THEN
BEGIN PART ← PART & TB ; LOPP(INPUTSTR) ; END END
ELSE IF INPUTSTR = COMMAND_CHARACTER ∨ INPUTSTR = TB THEN
BEGIN
LOPP(INPUTSTR) ;
BRC ← 0 ; comment, keep scanning ;
END
ELSE INPUTSTR ← (BRC ← RCBRAK) & VT & INPUTSTR ;
IF BRC THEN RETURN(IF LENGTH(RESULT)=0 THEN PART
ELSE IF LENGTH(PART)=0 THEN RESULT
ELSE RESULT & PART)
ELSE IF LENGTH(RESULT)=0 THEN RESULT ← PART
ELSE RESULT ← RESULT & PART ;
END "PARTIAL"
UNTIL FALSE ;
END "RD" ;
INTERNAL SIMPLE PROCEDURE RDENTITY ;
BEGIN Comment Sets THATWD, THATTYPE, LIT_ENTITY, LIT_TRAIL ;
STRING SEGMENT, SOURCE ; BOOLEAN DUN, TEXTLN ; INTEGER CC, FAM ; LABEL RETRY ;
TEXTLN ← FALSE ; RETRY: IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO_VISIBLE) ;
SOURCE ← INPUTSTR ;
FAM ← LDB(FAMILY(SOURCE)) ;
CASE FAM MIN QUOTEQ+1 OF
BEGIN COMMENT BY FAMILY ;
ie 0 ... Letter ;
BEGIN "BUILD ID"
CC ← LENGTH(SEGMENT ← SCAN(SOURCE, ALPHA, BRC)) ;
THATWD ← CAPITALIZE(SEGMENT);
THATTYPE ← 0 ;
END "BUILD ID" ;
ie 1 ... Digit ;
BEGIN "BUILD INTEGER"
CC ← LENGTH(THATWD ← "0" & SCAN(SOURCE, DIGITA, BRC)) - 1 ;
THATTYPE ← -1 ;
END "BUILD INTEGER" ;
ie 2 ... EMPTYQ ; IMPOSSIBLE("RDENTITY") ;
ie 3 ... Terminal ;
BEGIN "MAYBE TEXT"
IF LDB(SPECIES("THATWD ← LOP(SOURCE)")) = 0 THEN TEXTLN ← TRUE ;
CC ← 1 ; THATTYPE ← -TERQ ;
END "MAYBE TEXT" ;
ie 4 ... Quote ;
IF SOURCE = """" THEN
BEGIN "STRING CONSTANT"
DUN ← FALSE ; THATWD ← "7" ; LOPP(SOURCE) ; CC ← 1 ; ie skip " ;
DO BEGIN "TO NEXT QUOTE"
SEGMENT ← SCAN(SOURCE, TO_QUOTE_APPD, BRC) ;
CC ← CC + LENGTH(SEGMENT) ;
IF BRC ≠ """" THEN
BEGIN "ERROR"
THATWD ← THATWD & SEGMENT[1 TO ∞-1] ; DUN ← TRUE ;
WARN("=","Omitted Right Quote From: "&THATWD) ;
END "ERROR"
ELSE IF SOURCE = """" THEN
BEGIN "INTERNAL QUOTE"
THATWD ← THATWD & SEGMENT ;
LOPP(SOURCE) ; CC ← CC + 1 ; ie skip second " ;
END "INTERNAL QUOTE"
ELSE
BEGIN "END STRING"
THATWD ← THATWD & SEGMENT[1 TO ∞-1] ;
DUN ← TRUE ;
END "END STRING"
END "TO NEXT QUOTE"
UNTIL DUN ;
THATTYPE ← -1 ;
END "STRING CONSTANT"
ELSE
BEGIN "OCTAL CONSTANT"
LOPP(SOURCE) ; THATTYPE ← -1 ;
CC ← LENGTH(SEGMENT ← SCAN(SOURCE, DIGITA, BRC)) + 1 ;
THATWD ← "8" & (DUMMY←CVO(SEGMENT)) ; COMMENT a one-character string ;
IF DUMMY='0 ∨ '11≤DUMMY≤'15 ∨ DUMMY=ALTMODE ∨ DUMMY=RUBOUT THEN
BEGIN
WARN("=","Illegal octal constant (represents illegal character)") ;
THATWD ← "7" ;
END ;
END "OCTAL CONSTANT" ;
ie 5 ... Other ;
BEGIN "SINGLE CHARACTER"
THATTYPE ← -FAM ; CC ← 1 ; THATWD ← LOP(SOURCE) ;
IF FAM = MISCQ THEN CASE LDB(SPECIES(THATWD)) OF
BEGIN
[4] ie ∞ ; BEGIN THATTYPE ← 0 ; THATWD ← "!INF" END ;
[0] BEGIN "ILL CHAR"
WARN("=","EXTRANEOUS `" & THATWD & "' in command line") ;
LOPP(INPUTSTR) ; GO TO RETRY ;
END "ILL CHAR" ;
[MISCMAX]
END ;
END "SINGLE CHARACTER" ;
END ; COMMENT BY FAMILY ;
LIT_ENTITY ← INPUTSTR[1 TO CC] ;
INPUTSTR ← SOURCE ;
LIT_TRAIL ← IF TEXTLN THEN NULL ELSE IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO_VISIBLE) ELSE NULL ;
END "RDENTITY" ;
INTEGER SIMPLE PROCEDURE ESTIMATE ;
BEGIN
INTEGER TOT, LEFT ;
TOT ← LEFT ← IF AREAIXM ∧ 0≤STATUS≤2 THEN LINES ELSE LINECT(IXTEXT) ;
LEFT ← LEFT + XGENLINES; RKJ;
IF STATUS=1 THEN LEFT ← LEFT - (LINE + COVERED + PINE) ;
IF NOT NOPGPH THEN LEFT ← LEFT - ( 1+(ABOVEX MAX BRKABX)-(BELOWX MIN BRKBLX)+
(IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1) ) ;
RETURN(IF LEFT<0 THEN -(LEFT+TOT) ELSE LEFT) ;
END "ESTIMATE" ;
INTEGER SIMPLE PROCEDURE EMPTYCOLS ;
IF COL = 0 THEN RETURN(COLS)
ELSE BEGIN
INTEGER COUNT, COLUMN ; COUNT ← 0 ;
FOR COLUMN ← (COL - 1) MOD COLS + 1 THRU COLS DO
IF AA[COLUMN, 0] = 0 ∧ AA[COLUMN+COLS,0] = 0 THEN COUNT ← COUNT + 1 ;
RETURN(COUNT-(IF ESTIMATE<0 THEN 1 ELSE 0)) ;
END "EMPTYCOLS" ;
INTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
BEGIN comment, evaluates the "variable" in THISWD ;
CASE TYP OF
BEGIN COMMENT BY TYPE ;
[0] BEGIN IF ON THEN WARN("=","Undefined Identifier " & THISWD) ; RETURN(VIRGIN) END ;
[GLOBALTYPE] RETURN(STBL[IX]) ;
[LOCALTYPE] RETURN(SSTK[IX]) ;
[INTERNTYPE]
BEGIN "INTERNAL"
RETURN(CASE IX OF (
ie 0 ... LINES ; CVS(ABS(ESTIMATE)),
ie 1 ... COLUMNS; CVS(CASE STATUS+1 OF (
ie -1 ... no place area ; 0,
ie 0 ... unopened area ; COLS-(IF ESTIMATE<0 THEN 1 ELSE 0),
ie 1 ... open area ; EMPTYCOLS,
ie 2 ... closed area ; 0,
ie 3 ... dis-declared ; 0) ),
ie 2 ... ! ; !,
ie 3 ... SPREAD ; CVS(SPREADM),
ie 4 ... FILLING; IF ¬FILL THEN "0" ELSE IF ADJUST THEN "1" ELSE "-1",
ie 5 ... _SKIP_ ; CVS(MANUS_SKIP_),
ie 6 ... _SKIPL_; CVS(LH(MANUS_SKIP_)),
ie 7 ... _SKIPR_; CVS(RH(MANUS_SKIP_)),
ie 8 ... NULL ; NULL,
ie 9 ... ∞ ; CVS(INF),
ie 10... FOOTSEP; FOOTSEP,
ie 11... TRUE ; "-1",
ie 12... FALSE ; "0",
ie 13... INDENT1; CVS(FIRSTIM),
ie 14... INDENT2; CVS(RESTIM),
ie 15... INDENT3; CVS(RIGHTIM),
ie 16... LMARG ; CVS(LMARG),
ie 17... RMARG ; CVS(RMARG),
ie 18... CHAR ; IF NOPGPH THEN 0 ELSE CVS(POSN),
ie 19... CHARS ; CVS(IF NOPGPH THEN RMARG-LMARG ELSE MAXIM-POSN),
ie 20... LINE ; CVS(IF STATUS=1 THEN LINE ELSE 0),
ie 21... COLUMN ; CVS(IF STATUS=1 THEN COL ELSE 0),
ie 22... TOPLINE; CVS(LINE1(IF AREAIXM THEN AREAIXM ELSE IXTEXT)),
ie 23... XCRIBL; CVS(XCRIBL),
ie 24... CHARW ; CVS(CHARW),
ie 25... XGENLINES; CVS(XGENLINES),
ie 26... UNDERLINE ; VUNDERLINE, TES 10/22/73 ;
ie 27... THISDEVICE ; TES 11/15/73 ;
CASE ABS(DEVICE)-1 OF ("LPT","TTY","MIC","XGP"),
ie 28... THISFONT ; IF THISFONT < 10 THEN
THISFONT+"0" ELSE THISFONT+("A"-10),
WARN(NULL,"PUB BUG: EVALV CASE IX")
) ) ;
END "INTERNAL" ;
[MANTYPE] WARN("=",THISWD&" in an expression") ;
[PORTYPE] RETURN(THISWD) ;
[PUNITTYPE] RETURN(PATT_VAL("PATT_STRS(IX)")) ;
[AREATYPE] RETURN(THISWD) ;
[UNITTYPE] RETURN(CTR_VAL("PATT_STRS(IX)"))
END COMMENT BY TYPE ; ;
RETURN(NULL) ;
END "EVALV" ;
INTERNAL STRING SIMPLE PROCEDURE VEVAL ; RETURN(EVALV(THISWD, IX, THISTYPE)) ;
INTERNAL RECURSIVE STRING PROCEDURE PASS ; comment Value is always NULL ;
BEGIN comment, Load up WD[0:1], TYPE[0:1], SYMB, and IX for the parser.
Calls CHUNK recursively! PASS will expand macro calls,
replace macro/response arguments with their actual values,
skip over comments, and execute asides.;
PRELOAD_WITH 0, [3]3, 2, [4]3, 0, 1, 0, 4, [5]0, 5, 0, 0, 6, [7]0, 7, 0 ;
OWN INTEGER ARRAY SCANTYPE[-15:15] ; comment, computes small case index ;
BOOLEAN FINAL ;
DO BEGIN "LOAD WD 0"
IF ¬THATISFULL THEN RDENTITY ;
THISWD ← THATWD ;
THISTYPE ← IF THATTYPE THEN THATTYPE comment, non-identifier ;
ELSE IF SYMLOOK(THATWD) THEN LDB(TYPEN(SYMBOL))
ELSE 0 ; comment, undeclared identifier ;
IF THISTYPE ≠ -TERQ THEN RDENTITY ;
IF THISISID THEN
BEGIN "IDENTIFIER"
SYMB ← SYMBOL ;
IF ¬DCLR_ID ∧ THATISID ∧ SYMLOOK(THISWD & SP & THATWD) THEN
BEGIN comment, two-word macro name ;
THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MACROTYPE ;
IX ← LDB(IXN(SYMBOL)) ; RDENTITY ;
END
ELSE BEGIN SYMBOL←SYMB ; IF NULSTR(SYM[SYMB]) THEN ENTERSYM(THISWD,0) ; IX←LDB(IXN(SYMB)) ;END ;
END "IDENTIFIER" ;
FINAL ← FALSE ;
DO CASE SCANTYPE[THISTYPE] OF
BEGIN COMMENT DETECT ;
ie 0 ... Nothing to do ; BEGIN END ;
ie 1 ... $ ; IF NEXTSCH("(") THEN
BEGIN EMPTYTHAT ; THISWD←"⊂" ;
IX ← LDB(SPECIES(THISWD)) ; THISTYPE ← -TERQ ;
END
ELSE IX←LDB(SPECIES(THISWD)) ; COMMENT REPLACED OLD "ASIDE" (UNPUBL. FEATURE) 2/20/73 ;
ie 2 ... < Family ; IF ITSCH(<) AND NEXTSCH(<) THEN
BEGIN "<<COMMENT>>" SETBREAK(LOCAL_TABLE, ">"&RCBRAK&LF, NULL, "IS") ;
DO RD(LOCAL_TABLE) UNTIL BRC=">" ∧ INPUTSTR=">" ∨ BRC=RCBRAK ∧ INPUTSTR=VT ;
IF BRC=">" THEN RD(ONE_CHAR)
ELSE BEGIN WARN("=","Unterminated <<comment>>") ; INPUTSTR←BRC&INPUTSTR END ;
EMPTYTHIS ; EMPTYTHAT ;
END "<<COMMENT>>"
ELSE IX ← LDB(SPECIES(THISWD)) ; ie relational operator ;
ie 3 ... Expression Operators ; IX ← LDB(SPECIES(THISWD)) ;
ie 4 ... Terminal ;
BEGIN
IF ITSCH("]") ∧ INPUTSTR="$" THEN
BEGIN LOPP(INPUTSTR) ; THISWD ← RCBRAK END ;
EMPTYTHAT ; IX ← LDB(SPECIES(THISWD)) ;
END ; Comment NOTE!! }),]⊂;
ie 5 ... internal variable ; IF ¬DCLR_ID ∧ IX ≥ 200 THEN
BEGIN "OPERATOR"
IX ← IX-200 ; comment e.g., NOT → ¬ ;
THISTYPE ← -LDB(FAMILY(IX)) ;
IX ← LDB(SPECIES(IX)) ;
END "OPERATOR" ;
ie 6 ... reserved word ; IF IX=IXCOMMENT∧ ¬DCLR_ID THEN
BEGIN "COMMENT"
INPUTSTR ← LIT_ENTITY & INPUTSTR ;
DO RD(TO_SEMI_SKIP) UNTIL BRC=";" ∨ INPUTSTR=VT ;
IF BRC ≠ ";" THEN BEGIN WARN("=","Unterminated COMMENT;") ; INPUTSTR←BRC&INPUTSTR END ;
EMPTYTHIS ; EMPTYTHAT ; ;
END "COMMENT" ;
ie 7 ... macro name ; IF ¬DCLR_ID THEN
BEGIN "EXPAND MACRO"
INTEGER MACIX, MACSYM, ARGS, ARG, ARGSYM, NAMES, K ; BOOLEAN WASLPAR, DO_IT, DUMSEMI ;
DO_IT ← ON OR ODDMAC(IX) ; comment Whether to actually expand it, or make it NULL;
MACIX ← IX ; MACSYM ← SYMB ; ARGS ← NUMARGS(MACIX) ; DUMSEMI ← FALSE ;
IF ARGS THEN
BEGIN "SCAN ARGS"
STRING ARRAY ACTUAL[1:ARGS] ;
IF ¬(WASLPAR ← NEXTSCH("(")) THEN INPUTSTR ← LIT_ENTITY&LIT_TRAIL&INPUTSTR ;
comment , Back up. Pretend just passed comma. ; THISWD ← "," ; EMPTYTHAT ;
NAMES ← NAMEPAR(MACIX) ; comment bit table for name parameters ;
FOR ARG ← 1 THRU ARGS DO
BEGIN "EACH ACTUAL"
IF ¬ITSCH(",") THEN ACTUAL[ARG] ← NULL comment , omitted argument;
ELSE BEGIN RD(TO_VISIBLE) ;
IF NAMES LAND TWO(ARGS-ARG) = 0 THEN
BEGIN PASS ; ACTUAL[ARG] ← E(NULL, NULL&'0) ; END
ELSE BEGIN "CALL BY NAME"
IF BRC ≠ """" THEN
BEGIN comment , Unquoted Call-By-Name ;
IF (K←BRC)="|" THEN RD(ONE_CHAR) ;
ACTUAL[ARG]←RD(IF K="|" THEN TO_VBAR_SKIP
ELSE IF WASLPAR THEN TO_COMMA_RPAR ELSE TO_TERQ_CR) ;
IF BRC=CR ∧ ¬WASLPAR THEN
BEGIN comment force a semicolon ;
INPUTSTR ← ";" & INPUTSTR ;
DUMSEMI ← TRUE ;
END ;
PASS ;
END
ELSE BEGIN PASS ; ACTUAL[ARG]←E(NULL,0) END ;
END "CALL BY NAME"
END
END "EACH ACTUAL" ;
WHILE ITSCH(",") DO
BEGIN
WARN("=","Too Many Arguments to "&SYM[MACSYM]) ;
PASS ; E(NULL, 0) ;
END ;
IF ITSCH(")") ∧ WASLPAR THEN BEGIN comment Easy case; END
ELSE BEGIN
IF WASLPAR THEN WARN("=","Missed ) After Macro Call") ;
comment Back Up -- SWICH only saves THATWD ;
IF THATISFULL THEN comment Unlikely; INPUTSTR ← LIT_ENTITY&LIT_TRAIL&INPUTSTR ;
IF THISISFULL ∧ ¬DUMSEMI THEN BEGIN THATWD ← LIT_ENTITY ← THISWD ;
LIT_TRAIL ← IF THISTYPE<-1 THEN NULL ELSE SP ;
THATTYPE ← THISTYPE MIN 0 END ELSE EMPTYTHAT ;
END ;
IF DO_IT THEN
BEGIN "STACK ARGUMENTS"
IF LAST + ARGS > SIZE THEN GROWNESTS ;
FOR ARG ← 1 THRU ARGS DO
SNEST[LAST + ARG] ← ACTUAL[ARG] ;
LAST ← LAST + ARGS ;
END "STACK ARGUMENTS" ;
END "SCAN ARGS" ;
IF DO_IT THEN SWICH(SSTK[BODY(MACIX)], -1, ARGS)
ELSE BEGIN THISWD ← "7" ; THISTYPE ← -1 END ; ie, Replace by NULL ("") ;
END "EXPAND MACRO" ;
END COMMENT DETECT ; UNTIL (FINAL ← ¬FINAL) ;
END "LOAD WD 0" UNTIL THISISFULL ;
RETURN(NULL) ;
END "PASS" ;
INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
COMMENT Scan a SAIL-Like <Expression>. First check trivial case. ;
IF ITS(IF) THEN
BEGIN "CONDITIONAL EXPRESSION"
STRING BOOLX, THENX, ELSEX ; BOOLEAN WASON ;
WASON ← ON ; PASS ;
BOOLX ← E(NULL, "THEN") ; ON ← WASON ∧ TRUESTR(BOOLX) ;
IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional expression "&THISWD) ;
THENX ← E(NULL, "ELSE") ;
IF ITS(ELSE) THEN
BEGIN
ON ← WASON ∧ FALSTR(BOOLX) ; PASS ;
ELSEX ← E(NULL, STOPWORD) ;
END
ELSE ELSEX ← NULL ;
ON ← WASON ;
RETURN(IF TRUESTR(BOOLX) THEN THENX ELSE ELSEX) ;
END "CONDITIONAL EXPRESSION"
ELSE IF THISTYPE = -TERQ ∨ THISTYPE = MANTYPE ∨ ITSV(STOPWORD) THEN
RETURN(DEFAULT) comment omitted expression ;
ELSE IF THISTYPE ≥ -1 ∧ (THATTYPE = -TERQ ∨ THATTYPE=MANTYPE ∨ NEXTSV(STOPWORD)) THEN
RETURN(SPASS("IF THISISCON THEN THISWD[2 TO ∞] ELSE VEVAL"))
ELSE IF THISISID ∧ NEXTSCH(←) THEN comment, Assignment Expression ;
RETURN(VASSIGN(SYMB, THISTYPE, IX, E(IPASS(PASS), STOPWORD)))
ELSE
BEGIN "SIMPLE EXPRESSION"
STRING ANY, comment, result of A∨B∨...: has value of first TRUE operand;
ALL, comment, result of A∧B∧...: has value of first FALSE operand;
COMPARE, comment, result of A<B≤...: TRUE if all relations are TRUE;
LEFT, comment, preceding right comparator, saved for another comparison;
BOUNDARY, comment, result of A MAX B MIN... ;
PRODUCT, comment, result of * / MOD & ;
PRIMARY ; comment, <const>|<var>|( <expr> )|<unary><primary>|<primary><substr spec> ;
INTEGER OROP, comment, =0 signals ∨ waiting for right operand ;
ANDOP, NOTOP, comment, =0 signals ∧ or ¬ operator waiting ;
RELOP, ODDOP, BOUNDOP, ADDOP, MULOP, comment, ≥0 signals operator waiting ;
UNARYOP, comment, ≥0 signals unary operators waiting ;
U, comment, last of a series of unary operators ;
SS1, comment, starting byte number in substring spec ;
SAVEINF, comment, saved outside value of ∞ ;
SYMPTR, comment, symbol table number of identifier ;
IDTYPE, comment, type field in its NUMBER entry ;
ICOMPARE, ILEFT, IBOUNDARY, ISUM, IPRODUCT, IPRIMARY ; comment, CVD(corresponding string);
BOOLEAN WASONA, WASONO ; comment value of ON before a series of conjuncts or disjuncts ;
DEFINE TRYFAMILY(FAM) = "IF THISTYPE=-FAM THEN IPASS(IX)";
COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , and ↑ ) are combined
into a single operator by inventing new operators such as
"-ABS" and "ABS LENGTH" ;
DEFINE P = "0", comment, +X ; M = "1", comment, -X ; A = "2", comment, ABS X ;
MA = "3", comment, -ABS X ; C = "4", comment, ↑X ;
L = "5", comment, LENGTH(X) ; ML = "6", comment -LENGTH(X) ;
AL = "7", comment, ABS LENGTH(X) ; MAL = "8"; comment, -ABS LENGTH(X) ;
PRELOAD_WITH comment RIGHT OPERATOR
------------------------
LEFT OPERATOR + - ABS ↑ LENGTH
------------- --- --- --- --- --------
none; P, M, A, C, L,
comment P ; P, M, A, P, L,
comment M ; M, P, MA, M, ML,
comment A ; A, A, A, A, AL,
comment MA ; MA, MA, MA, MA, MAL,
comment C ; P, M, A, C, L ;
OWN INTEGER ARRAY COMBINE[-1:4,0:4] ;
COMMENT This is a top-down expression parser, but iteration is used
instead of recursion for rapidity ;
OROP ← ANDOP ← NOTOP ← RELOP ← BOUNDOP ← ADDOP ← MULOP ← -1 ;
WASONO ← ON ;
DO BEGIN "DISJUNCTS" ie Operands of ∨ ;
WASONA ← ON ;
DO BEGIN "CONJUNCTS" ie Operands of ∧ ;
WHILE THISTYPE = -NOTQ DO BEGIN NOTOP ← -1 - NOTOP ; PASS END ;
ICOMPARE ← TRUE ;
DO BEGIN "COMPARATORS" ie Operands of < = etc. ;
ODDOP ← TRYFAMILY(ODDQ) ELSE -1 ;
DO BEGIN "BOUNDS" ie Operands of MAX and MIN ;
DO BEGIN "TERMS" ie Operands of + - ≡ ⊗ ;
DO BEGIN "FACTORS" ie Operands of * / MOD & ;
UNARYOP ← -1 ; ie check for Unary Operators ;
WHILE UNARYOP≤3 ie no, P, M, A, or MA left operator ;
AND 0 ≤ (U ← TRYFAMILY(ADDQ) ELSE -1) ie some right operator ;
DO UNARYOP ← COMBINE[UNARYOP, U] ;
comment PRIMARY ;
IF THISISCON THEN BEGIN PRIMARY ← THISWD[2 TO ∞] ; PASS END
ELSE IF THISISID THEN
IF ITSV(STOPWORD) THEN
BEGIN
PRIMARY ← DEFAULT ;
WARN("=","Ill-Formed Expression" & THISWD) ;
END
ELSE BEGIN PRIMARY ← VEVAL ; PASS END
ELSE IF ITSCH("(") THEN
BEGIN "( <EXPR> )"
PASS ; PRIMARY ← E(DEFAULT, 0) ;
IF ITSCH(")") THEN PASS ELSE WARN("=","Missed )") ;
END "( <EXPR> )"
ELSE BEGIN WARN("=","Ill-Formed expression" & THISWD) ; PRIMARY ← DEFAULT END ;
WHILE THISTYPE=-BROKQ DO ie Substring Specifications ;
BEGIN "SUBSPEC"
PASS ; SAVEINF ← INF ; INF ← LENGTH(PRIMARY) ;
SS1 ← CVD(E("1", IF NEXTS(TO) THEN "TO" ELSE "FOR")) ;
IF ITS(TO) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 TO CVD(E("0",0))] END
ELSE IF ITS(FOR) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 FOR CVD(E("1",0))] END
ELSE PRIMARY ← PRIMARY[SS1 FOR 1] ;
MANUS_SKIP_ ← _SKIP_ ;
IF ITSCH(]) THEN PASS ELSE WARN("=","Missed ] in substring spec " & THISWD) ;
INF ← SAVEINF ;
END "SUBSPEC" ;
IF UNARYOP≤3 THEN IPRIMARY ← CVD(PRIMARY) ; ie both int & str versions maintained when needed ;
IF UNARYOP ≥ 0 THEN IF UNARYOP=C THEN IPRIMARY←CVD(PRIMARY←CAPITALIZE(PRIMARY))
ELSE PRIMARY ← CVS(IPRIMARY ← CASE UNARYOP OF (IPRIMARY, -IPRIMARY,
ABS IPRIMARY, -ABS IPRIMARY, 0, LENGTH(PRIMARY), -LENGTH(PRIMARY),
ABS LENGTH(PRIMARY), -ABS LENGTH(PRIMARY) ) ) ;
IF MULOP<0 THEN BEGIN PRODUCT ← PRIMARY ; IPRODUCT ← IPRIMARY END
ELSE IF MULOP = 3 THEN IPRODUCT ← CVD(PRODUCT ← PRODUCT & PRIMARY)
ELSE PRODUCT ← CVS(IPRODUCT ← IF IPRIMARY=0 ∨ ¬ON THEN 0 ELSE CASE MULOP OF
(IPRODUCT*IPRIMARY, IPRODUCT DIV IPRIMARY, IPRODUCT MOD IPRIMARY) ) ;
MULOP ← TRYFAMILY(MULQ) ELSE -1 ;
END "FACTORS" UNTIL MULOP < 0 ;
ISUM ← CASE ADDOP+2 OF (IPRODUCT, IPRODUCT, ISUM + IPRODUCT,
ISUM - IPRODUCT, ISUM ≡ IPRODUCT, ISUM ⊗ IPRODUCT) ;
ADDOP ← TRYFAMILY(ADDQ) ELSE IF ADDOP<0 THEN -1 ELSE -2 ;
END "TERMS" UNTIL ADDOP < 0 ;
IBOUNDARY ← CASE BOUNDOP+2 OF (ISUM, ISUM, IBOUNDARY MAX ISUM, IBOUNDARY MIN ISUM) ;
BOUNDOP ← TRYFAMILY(BOUNDQ) ELSE IF ADDOP=-1 ∧ BOUNDOP<0 THEN -1 ELSE -2 ;
END "BOUNDS" UNTIL BOUNDOP < 0 ;
BOUNDARY ← IF BOUNDOP = -1 THEN PRODUCT ie, hasn't changed since then; ELSE CVS(IBOUNDARY) ;
IF ODDOP≥0 THEN BOUNDARY←CVS(IBOUNDARY←(IBOUNDARY MOD 2)=ODDOP);
IF ICOMPARE THEN CASE RELOP+2 OF BEGIN comment SAIL Bug precludes case expression with relationals;
BEGIN END ; BEGIN END ; ICOMPARE←ILEFT<IBOUNDARY; ICOMPARE←ILEFT>IBOUNDARY; ICOMPARE ←
EQU(LEFT,BOUNDARY); ICOMPARE←ILEFT≤IBOUNDARY; ICOMPARE←ILEFT≥IBOUNDARY;
ICOMPARE←¬EQU(LEFT,BOUNDARY) END ;
RELOP ← TRYFAMILY(RELQ) ELSE IF RELOP < 0 THEN -1 ELSE -2 ;
LEFT ← BOUNDARY ; ILEFT ← IBOUNDARY ;
END "COMPARATORS" UNTIL RELOP < 0 ;
COMPARE ← IF RELOP=-1 THEN BOUNDARY ELSE CVS(ICOMPARE) ;
IF NOTOP = 0 THEN COMPARE ← IF TRUESTR(COMPARE) THEN "0" ELSE "-1" ;
NOTOP ← -1 ;
IF ANDOP < 0 OR TRUESTR(ALL) THEN IF FALSTR(ALL ← COMPARE) THEN ON ← FALSE ;
ANDOP ← TRYFAMILY(ANDQ) ELSE -1 ; ALL ← ALL ; comment SAIL bug -- force it to store;
END "CONJUNCTS" UNTIL ANDOP < 0 ;
ON ← WASONA ;
IF OROP < 0 OR FALSTR(ANY) THEN IF TRUESTR(ANY ← ALL) THEN ON ← FALSE ;
OROP ← TRYFAMILY(ORQ) ELSE -1 ; ANY ← ANY ; comment SAIL bug -- force it to store ;
END "DISJUNCTS" UNTIL OROP < 0 ;
ON ← WASONO ;
RETURN(DUMMYSTR ← ANY) ; comment, DUMMYSTR due to SAIL RECURSIVE STRING PROCEDURE bug (see DCS);
END "SIMPLE EXPRESSION" ;
STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE; INTEGER ARGS, IBASE) ;
BEGIN
STRING SEGMENT, IDENT, PSPCS, SPCS, FML, TXID, TX2 ; INTEGER SINDX, I, DEEP ; LABEL FORMAL ;
IF ITSCH(;) THEN PASS ; DEFINING ← NOT FORFILE ; comment, makes RD include line nos in result ;
IF ¬ITSCH(⊂) AND NOT(ITSCH($) AND NEXTSCH("("))
THEN BEGIN WARN("=","Missed ⊂ OR $( in definition") ; RETURN(NULL) END ;
DEEP ← 1 ; SINDX ← SHIGH ;
IF SHIGH+20>STSIZE THEN
BEGIN
SGROW(STBL,STBLIDA,STSIZE,100,"Definition") ;
SMAKEBE(STBLIDA, STBL) ; ZEROSTRINGS(100, STBL[STSIZE-99]) ;
END ;
EMPTYTHIS ; comment For page label switch in LABELREF ;
IF FORFILE THEN STBL[SINDX←SINDX+1] ← SRCLINE & "/" & SRCPAGE & TB & ALTMODE ;
IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN
BEGIN
STBL[SINDX ← SINDX + 1] ← CRLF & SRCLINE & "/" & SRCPAGE & TB ;
INPUTSTR ← INPUTSTR[3:∞] ;
END ;
WHILE DEEP DO
BEGIN "DEF BODY"
SEGMENT ← RD(DEFN_TABLE) ;
IF BRC = "⊂" ∨ BRC="$"∧INPUTSTR="("∧LOP(INPUTSTR)="(" THEN
BEGIN DEEP ← DEEP + 1 ; SEGMENT ← SEGMENT & "⊂" ; END
ELSE IF BRC = "⊃" ∨ BRC=")"∧INPUTSTR="$"∧LOP(INPUTSTR)="$" THEN
BEGIN DEEP ← DEEP - 1 ;
SEGMENT ← SEGMENT & (IF DEEP THEN "⊃" ELSE SP) ;
END
ELSE IF BRC = "∃" THEN SEGMENT ← SEGMENT & (IF DEEP>1 THEN BRC ELSE NULL) & RD(ONE_CHAR)
ELSE IF LENGTH(TXID←BRC) ∧
(LDB(SPCODE(BRC))=LCURLY ∨
LDB(SPCODE(BRC))=DOLLAR ∧ LDB(SPCODE(INPUTSTR))=LBRACK ∧
LENGTH(TXID←TXID&LOP(INPUTSTR))) THEN
IF SUBSTVARIABLES THEN
BEGIN "{..."
SPCS ← TXID & RD(TO_VISIBLE) ;
IDENT ← SCAN(INPUTSTR,ALPHA,DUMMY) ; PSPCS ← RD(TO_VISIBLE) ;
IF BRC = RCBRAK ∨ BRC="]"∧INPUTSTR[2 FOR 1]="$"THEN
BEGIN
LOPP(INPUTSTR) ;
IF BRC="]" THEN BEGIN TX2←"]$" ; LOPP(INPUTSTR) END ELSE TX2←RCBRAK ;
SEGMENT ← SEGMENT &
(IF FULSTR(IDENT) ∧ SIMLOOK(CAPITALIZE(IDENT)) THEN
IF SYMIX=IXPAGE THEN ALTMODE&"[@]"&
LABELREF(0,
IF SYMBOL=SYMPAGE THEN CTR_CHRS(IXPAGE)
ELSE PATT_CHRS(IXPAGE))
ELSE EVALV(IDENT, SYMIX, SYMTYPE)
ELSE SPCS & IDENT & PSPCS & TX2)
END
ELSE SEGMENT ← SEGMENT & SPCS & IDENT & PSPCS ;
END "{..."
ELSE SEGMENT ← SEGMENT & TXID
ELSE IF BRC = RCBRAK THEN
IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN ELSE SEGMENT ← SEGMENT & BRC
ELSE IF LDB(FAMILY(BRC)) = LETTQ THEN
BEGIN "LETTER"
IDENT ← (BRC+0) & SCAN(INPUTSTR, ALPHA, BRC) ;
FOR I ← 1 THRU ARGS DO IF EQU(FML←SYM[ITBL[IBASE+I]], TXID←CAPITALIZE(IDENT)) THEN
FORMAL: BEGIN IDENT ← VT & I ; DONE END
ELSE IF 1 ≤ LENGTH(TXID)-LENGTH(FML) ≤ 2 THEN
BEGIN "MAYBE UNDERLINED"
INTEGER L, R ;
L ← IF TXID="_" THEN 1 ELSE 0 ; R ← IF TXID[∞ FOR 1]="_" THEN 1 ELSE 0 ;
IF EQU(FML, TXID[1+L TO ∞-R]) THEN
BEGIN
IF L THEN SEGMENT ← SEGMENT & "_" ;
IF R THEN INPUTSTR ← "_" & INPUTSTR ;
GO TO FORMAL ;
END ;
END "MAYBE UNDERLINED" ;
SEGMENT ← SEGMENT & IDENT ;
END "LETTER"
ELSE SEGMENT ← SEGMENT & BRC ;
STBL[SINDX ← SINDX+1] ← SEGMENT ;
IF SINDX = SHIGH+20 THEN
BEGIN
SEGMENT ← STBL[SHIGH + 1] ;
FOR I ← SHIGH + 2 THRU SINDX DO BEGIN SEGMENT ← SEGMENT & STBL[I] ; STBL[I]←NULL; END;
SINDX ← SHIGH + 1 ; STBL[SINDX] ← SEGMENT ;
END ;
END "DEF BODY" ;
SEGMENT ← STBL[SHIGH+1] ; FOR I ← SHIGH+2 THRU SINDX DO SEGMENT ← SEGMENT & STBL[I] ;
IF FORFILE THEN SEGMENT ← SEGMENT & LF ;
DEFINING ← FALSE ; INPUTSTR ← ";" & INPUTSTR ; PASS ;
RETURN(SEGMENT) ;
END "DEFN" ;
RECURSIVE PROCEDURE PARAMS(INTEGER MOST; STRING ARRAY PRE,PAR,POST);
BEGIN comment, Reads arguments for various commands;
INTEGER I, PREWD, SOFAR ; STRING EXPR ;
LABEL RDPAR, SETPAR ;
BOOLEAN GOT ; DEFINE FIND = "FOR I ← 1 THRU MOST DO IF" ;
SOFAR ← I ← GOT ← 0 ;
WHILE SOFAR<MOST ∧ THISTYPE≠-TERQ ∧ THISTYPE≠MANTYPE DO
BEGIN "PARAMETER"
IF THISISID THEN
BEGIN "IDENTIFIER"
IF ITS(TO) ∧ I<MOST ∧ ITSV(PRE[I+1]) THEN BEGIN PASS; I←I+1; GO TO RDPAR END;
FIND ITSV(PRE[I]) ∨ ITSV(PRE[I]&"S") THEN
BEGIN "PRE WORD"
PASS ; IF GOT LAND TWO(I) THEN WARN("=",PRE[I]&" Twice") ;
GO TO RDPAR ;
END "PRE WORD" ;
END "IDENTIFIER" ;
FIND ¬GOT LAND TWO(I) ∧ NULSTR(PRE[I]) ∧ (I=1 ∨ NULSTR(PRE[I-1]) ∨ GOT LAND TWO((I-1))) THEN GO TO RDPAR ;
DONE ;
RDPAR:
PREWD ← I ;
EXPR ← IF EQU(PRE[I],"IN") ∧ FULSTR(PAR[I]) THEN SPASS(THISWD) comment COUNT...IN -- ;
ELSE IF ITSCH(⊂) THEN 0 & DEFN(FALSE, FALSE, 0, 0)
ELSE E(NULL,IF I=MOST∨FULSTR(POST[I]) THEN POST[I] ELSE PRE[I+1]) ;
IF FULSTR(POST[I]) THEN
IF ITSV(POST[I]) THEN PASS
ELSE BEGIN "GUESSED WRONG"
FIND ITSV(POST[I]) THEN BEGIN PASS ; GO TO SETPAR END ;
FIND NULSTR(POST[I]) THEN GO TO SETPAR ;
WARN("=",POST[PREWD] & "Missed.") ;
DONE ;
END "GUESSED WRONG" ;
SETPAR:
IF PRE[I]≠PRE[PREWD] THEN WARN("=",(IF FULSTR(POST[PREWD]) THEN POST[PREWD] ELSE PRE[I])& " Missed.") ;
IF GOT LAND TWO(I) THEN WARN("=","Duplicate Parameter "&PRE[I]&SP&EXPR&SP&POST[I])
ELSE SOFAR ← SOFAR + 1 ;
GOT ← GOT LOR TWO(I) ;
PAR[I] ← EXPR ;
IF ITSCH(",") THEN PASS ;
END "PARAMETER" ;
END "PARAMS" ;
RECURSIVE STRING PROCEDURE SIMPAR ;
RETURN(IF THISISCON THEN THISWD[2 TO ∞] ELSE IF THISISID THEN VEVAL ELSE NULL) ;
SIMPLE PROCEDURE FINPORTION ;
BEGIN
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
END "FINPORTION" ;
RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) ;
BEGIN
INTEGER I, IX, SYMB, TEMP, A, B ;
PRELOAD_WITH "LINE", "TO", "CHAR", "TO", "IN", "COLUMN", "COLUMN" ;
OWN STRING ARRAY PRE[1:7] ; STRING ARRAY PAR[1:7] ;
PRELOAD_WITH NULL, NULL, NULL, NULL, NULL, "WIDE", "APART" ;
OWN STRING ARRAY POST[1:7] ;
DBREAK; DPASS ;
IF ¬THISISID THEN BEGIN WARN("=","AREA MUST HAVE NAME"); THISWD←"!DUMMY" END ;
SYMB ← SYMNUM(THISWD) ;
PASS ;
PARAMS(7, PRE, PAR, POST) ;
IF ¬ON THEN RETURN ;
BIND(DECLARE(SYMB, AREATYPE), IX←PUSHI(AREAWDS,AREATYPE)) ;
IF FULHIGH(IX)←NULSTR(PAR[1]) THEN BEGIN A←1 ; B←FHIGH END comment assume LINE 1 TO <frame height> ;
ELSE BEGIN A ← CVD(PAR[1]) ; B ← IF NULSTR(PAR[2]) THEN A ELSE CVD(PAR[2]) END ;
LINE1(IX) ← A MAX 1 ; LINECT(IX) ← B-A+1 MAX 1 ;
IF FULWIDE(IX)← NULSTR(PAR[3]) THEN BEGIN A←1 ; B←FWIDE END
ELSE BEGIN A ← CVD(PAR[3]) ; B ← IF NULSTR(PAR[4]) THEN A ELSE CVD(PAR[4]) END ;
CHAR1(IX) ← A MAX 1 ; CHARCT(IX) ← B←B-A+1 MAX 1 ;
TEXTAR(IX) ← IF TITAREA THEN 0 ELSE 1 ;
IF NULSTR(PAR[5]) THEN A ← 1 comment Assume IN 1 COLUMNS <charct> WIDE ;
ELSE BEGIN "COLUMNS"
A ← CVD(PAR[5]) ; comment How many ;
IF FULSTR(PAR[6]) THEN B ← CVD(PAR[6]) MIN B DIV A
ELSE B ← (B+( TEMP←IF FULSTR(PAR[7]) THEN CVD(PAR[7]) ELSE 5 )) DIV A - TEMP ;
END "COLUMNS" ;
COLCT(IX) ← A MAX 1 ; COLWID(IX) ← B MAX 1 ;
OLMAX ← OLMAX + A*LINECT(IX) ;
FOOTSTR(IX) ← PUSHS(1, NULL) ;
MARGINS(IX) ← FONTS(IX) ← 0 ; TES 11/15/73 ;
TFONT(IX) ← OFONT(IX) ← DEFAULTFONT ; TES 11/15/73 ;
END "DAREA" ;
SIMPLE PROCEDURE DBELOW ;
BEGIN
END "DBELOW" ;
PROCEDURE DBLANKPAGE ;
BEGIN COMMENT LEAVE N BLANK PAGES WITHOUT AFFECTING THE PAGE NUMBER ;
INTEGER I, J, N ;
PASS ; N ← CVD(E("1", NULL)) ;
IF ¬ON THEN RETURN ;
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
IF INTER ≤ 0 THEN NOPORTION ;
FOR I ← 1 THRU N DO FOR J ← PHIGH, PWIDE, -10 DO WORDOUT(INTER, J) ;
END ;
SIMPLE PROCEDURE DCC ;
BEGIN
END "DCC" ;
SIMPLE PROCEDURE DCLOSE ;
BEGIN
DBREAK ; PASS ;
IF ON THEN
IF THISTYPE=AREATYPE THEN CLOSEAREA(IX,FALSE)
ELSE IF IX=IXPAGE THEN comment, * * * * * * * * * * * * * ;
ELSE WARN("=","CLOSE What? "&SOMEINPUT) ;
PASS ;
END "DCLOSE" ;
SIMPLE PROCEDURE DCOMMANDCHARACTER ;
BEGIN
INTEGER X ;
INPUTSTR ← ";;" & INPUTSTR ; COMMENT couple extra semicolons to assure next line read right ;
PASS ; X ← SIMPAR ;
IF LENGTH(X) ≠ 1 THEN WARN("=","COMMAND CHARACTER must be a single character, not `"&X&"'")
ELSE IF ON THEN COMMAND_CHARACTER ← X ;
PASS ; PASS ; PASS ;
END "DCOMMANDCHARACTER" ;
SIMPLE PROCEDURE DCOUNT ;
BEGIN
INTEGER USYMB, INLINE ;
PRELOAD_WITH "FROM", "TO", "BY", "IN", "PRINTING" ;
OWN STRING ARRAY PRE[1:5] ; OWN STRING ARRAY PAR[1:5] ;
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unit must have a name") ; THISWD ← "!DUMMY" END ;
USYMB ← SYMNUM(THISWD) ; PASS ; IF ITS(INLINE) THEN BEGIN INLINE←TRUE; PASS END ELSE INLINE←FALSE ;
PAR[1]←PAR[2]←PAR[3]←PAR[5]←NULL;
PAR[4] ← 0 ; PARAMS(5, PRE, PAR, NULLS) ;
IF ON THEN CREUNIT( INLINE,
IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]), comment, FROM -- ;
IF NULSTR(PAR[2]) THEN 18 ELSE CVD(PAR[2]), comment, TO -- ;
IF NULSTR(PAR[3]) THEN 1 ELSE CVD(PAR[3]), comment, BY -- ;
IF PAR[4] = 0 THEN 0 ELSE SYMNUM(PAR[4]), comment IN -- ;
IF NULSTR(PAR[5]) THEN "1" ELSE PAR[5], comment, PRINTING -- ;
USYMB ) ;
END "DCOUNT" ;
SIMPLE PROCEDURE DDEVICE ;
BEGIN PASS ;
IF DEVICE ≥ 0 THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
IF ITS(MIC) THEN DEVICE←MIC ELSE IF ITS(TTY) THEN DEVICE←TTY
ELSE IF ITS(LPT) THEN DEVICE←LPT
ELSE IF ITS(XGP) THEN BEGIN DEVICE ← XGP; XCRIBL ← TRUE; OUTSTR(" XCRIBL!"); END
ELSE WARN("=","No such device: "&THISWD) ;
PASS ;
END "DDEVICE" ;
RECURSIVE PROCEDURE DCONDITIONAL ;
BEGIN
BOOLEAN WASON ;
WASON ← ON ; PASS ; ON ← TRUESTR("E(NULL,""THEN"")") ∧ WASON ;
IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional statement "&THISWD) ;
STATEMENT;
IF ITS(ELSE) THEN BEGIN ON←WASON∧¬ON; PASS ; STATEMENT END ;
ON ← WASON ;
END "DCONDITIONAL" ;
INTERNAL SIMPLE PROCEDURE READFONT(INTEGER WHICH; STRING FILENAME) ;
IF ON THEN
BEGIN "READFONT"
INTEGER SAVCW, CHAN, ZILCH, EOF;
IFC TENEX THENC STRING ELSEC INTEGER ENDC NAME, EXT, PPN ;
LABEL TRYAGAIN ; COMMENT SAIL DEFFICIENCY ;
SAVCW ← WHATIS(CW);
IF FONTFIL[WHICH] = 0 THEN FONTFIL[WHICH] ← CREATE(0,127);
DUMMY ← FONTFIL[WHICH] ;
IF SAVCW=WCW AND WHICH=DEFAULTFONT THEN SAVCW←DUMMY;
MAKEBE(DUMMY,CW);
OPEN(CHAN←GETCHAN,"DSK",'14, 2,0,0,ZILCH,EOF);
TRYAGAIN: NAME←CVFIL(FILENAME,EXT,PPN);
WHILE TRUE DO
BEGIN "LKUPLOOP"
IF XLOOKUP(CHAN,NAME,EXT,0,PPN) THEN DONE;
IF EXT=0 THEN EXT←FONTEXT ELSE
IF PPN=0 THEN PPN←FONTPPN ELSE
BEGIN "NOTFOUND"
OUTSTR("Font file " & FILENAME & " not found. Read file: ");
FILENAME ← INCHWL ;
GO TRYAGAIN ;
END "NOTFOUND";
END "LKUPLOOP";
IFC VERSION=CMUVER THENC
WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN); COMMENT RKJ 10-10-73;
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
BEGIN DUMMY←WORDIN(CHAN); CW[DUMMY]←WORDIN(CHAN) END
ENDC
IFC VERSION=SAILVER THENC
ARRYIN(CHAN,CW[0],128);
FOR I ← 0 THRU 127 DO CW[I] ← CW[I] LSH -18;
WORDIN(CHAN); FNTINF[WHICH]←WORDIN(CHAN);
WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN);
ENDC
IFC VERSION=PARCVER THENC
BEGIN
EXTERNAL INTEGER GOGTAB;
INTEGER K,I;
START!CODE "BYTE16" MOVE 1,GOGTAB; ADD 1,CHAN; MOVE 1,'13(1); comment now we have pointer to cdb;
HRRZ 1,2(1); comment now pointer to IBUF;
HRLI 2,'442000;
HLLM 2,1(1);
END "BYTE16";
K←WORDIN(CHAN); WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN); WORDIN(CHAN);
FOR I←1 THRU K DO WORDIN(CHAN);
K←(K MIN 128)-1;
FOR I←0 THRU K DO CW[I]←WORDIN(CHAN);
END;
ENDC;
IFC VERSION=SAILVER THENC CMDFILE ← CMDFILE & "/FONT#" & CVS(WHICH-1) & "=" & FILENAME ENDC;
RELEASE(CHAN);
MAKEBE(SAVCW,CW);
END "READFONT";
INTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ;
BEGIN TES 11/15/73 TO DO IT BY AREA ;
INTEGER NEWIX ;
IF AREAIXM AND FONTS(AREAIXM) < OLDIHED THEN
BEGIN TES FIRST CHANGE IN THIS BLOCK IN THIS AREA ;
NEWIX ← PUSHI(FONTWDS, FONTYPE) ;
AREAX(NEWIX) ← AREAIXM ;
OUTERX(NEWIX) ← FONTS(AREAIXM) ;
THISFONTX(NEWIX) ← THISFONT ;
OLDFONTX(NEWIX) ← OLDFONT ;
FONTS(AREAIXM) ← NEWIX ;
END ;
OLDFONT ← THISFONT;
IF THISFONT NEQ WHICH THEN
BEGIN
THISFONT ← WHICH;
WHICH ← FONTFIL[WHICH]; MAKEBE(WHICH,CW);
END ;
END ;
INTERNAL SIMPLE PROCEDURE SELECTFONT(INTEGER WHICH);
IF ON THEN
BEGIN "SELECTFONT"
INTEGER F;
DBREAK;
IF NOT XCRIBL OR LAST<4 THEN RETURN;
F←(IF WHICH<10 THEN (WHICH+"0") ELSE (WHICH+("A"-10)));
IF FONTFIL[WHICH]=0 THEN BEGIN WARN("=","Unknown font `"& F & "'");
RETURN END;
SWITCHFONT(WHICH) ; TES 11/14/73 SUBROUTINIZED ;
TES 11/15/73 erased: XGPCMD ← (FONTCHAR & "F") & F ;
END "SELECTFONT";
SIMPLE PROCEDURE DFONT(BOOLEAN SELECT);
BEGIN "DFONT"
INTEGER F;
PASS;
F ← THISWD[(IF THISTYPE=-1 THEN 2 ELSE 1) FOR 1] ;
IF ON THEN
IF "1"≤F≤"9" THEN F←F-"0"
ELSE IF "A"≤F≤"Z" THEN F←F-("A"-10)
ELSE IF "a"≤F≤"z" THEN F←F-("a"-10)
ELSE BEGIN WARN("=","Illegal font `"&F&"'"); PASS; RETURN END;
PASS;
IF SELECT THEN SELECTFONT(F) ELSE READFONT(F,E(NULL,NULL));
END "DFONT";
RECURSIVE PROCEDURE DFRAME(BOOLEAN BOXFRM) ;
BEGIN
INTEGER L, I ;
PRELOAD_WITH "HIGH", "WIDE" ; OWN STRING ARRAY POST[1:2];
STRING ARRAY PAR[1:2] ;
DAPART ; PASS ; PARAMS(2,NULLS,PAR,POST);
IF ON THEN
IF BOXFRM THEN BEGIN END
ELSE
BEGIN
PHIGH←FHIGH←IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]) ;
PWIDE←FWIDE←IF NULSTR(PAR[2]) THEN 1 ELSE CVD(PAR[2]) ;
IF OLDPGIDA THEN NEXTPAGE ;
L ← NULLAREAS ;
WHILE L DO BEGIN
I ← AREAIDA ; IDASSIGN(AREAIDA←L,THISAREA) ; L ← RH(INA) ;
OPEN_ACTIVE(DEFA) ← 0 ; GOAWAY(AREAIDA) ; IF (AREAIDA←I) THEN IDASSIGN(AREAIDA,THISAREA) ;
END ;
NULLAREAS ← 0 ;
END ;
END "DFRAME" ;
SIMPLE PROCEDURE DINDENT ;
BEGIN
STRING X ;
DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON ∧ FULSTR(X) THEN FIRSTIM ← CVD(X) ;
IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON ∧ FULSTR(X) THEN RESTIM←CVD(X) ;
IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON ∧ FULSTR(X) THEN RIGHTIM←CVD(X) ;
END "DINDENT" ;
SIMPLE PROCEDURE DINSERT ;
BEGIN
INTEGER CHAN, PIX, ROTTEN ;
FINPORTION ;
IF INTER ≥ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) ; SINTER←INTER←-1 END ;
DO BEGIN "COLLATE"
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed INSERT Portion!") ; RETURN END ;
IF ON THEN
BEGIN ROTTEN ← FALSE ;
IF THISTYPE ≠ PORTYPE THEN BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -5))
ELSE IF (CHAN ← PORCH(PIX ← IX)) = -1 THEN BEGIN WARN("=","Can't INSERT FOOT!"); ROTTEN←TRUE END
ELSE IF ¬(0 ≤ CHAN ≤ 15) THEN BEGIN WARN("=","Can't INSERT passed Portion "&THISWD) ; ROTTEN←TRUE END ;
IF ¬ROTTEN THEN BEGIN PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT ← PIX) ← -1 END ;
PASS ;
END ;
END "COLLATE" UNTIL ¬ITSCH(",") ;
END "DINSERT" ;
SIMPLE PROCEDURE DLET ;
BEGIN
INTEGER LOC ; LABEL BADLET ;
DPASS ; IF THATISID THEN BEGIN THATWD ← THISWD & THATWD ; DPASS END ; LOC ← SYMB ;
IF ¬THISISID THEN GO TO BADLET ; PASS ; IF ¬ITSCH(=) THEN GO TO BADLET ; DPASS ;
IF THISTYPE≠MANTYPE AND THATISID THEN BEGIN THATWD←THISWD&THATWD ; PASS END ;
IF THISTYPE≠MANTYPE THEN GO TO BADLET ; IF ON THEN BIND(LOC←DECLARE(LOC, MANTYPE), IX) ; PASS ;
RETURN ;
BADLET: WARN("=","LET <ID>=<RESWD>, please!") ; DO PASS UNTIL THISISID ∨ THISTYPE=-TERQ ;
END "DLET" ;
SIMPLE PROCEDURE DLOCK ;
BEGIN
END "DLOCK" ;
SIMPLE PROCEDURE DLOCAL ;
DO BEGIN
DPASS ;
IF THISISID THEN
BEGIN
IF ON THEN
BIND(SYMB←DECLARE(SYMB, LOCALTYPE), IX←PUSHS(1,NULL)) ;
PASS ;
END
ELSE BEGIN WARN("=","LOCAL declaration missing identifier"); IF THISTYPE≠TERQ THEN PASS END ;
END UNTIL ¬ITSCH(",") ;
SIMPLE PROCEDURE DMACRO(BOOLEAN ODDONE) ;
BEGIN COMMENT, OLD VERSION NOT GARBAGED BUT COULD BE ;
INTEGER SIHIGH, MIX, ARGS, J, NAMES, NAME ; BOOLEAN ROTTEN ;
SIHIGH ← IHIGH ; DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Macro name not identifier") ; RETURN END ;
IF THATISID THEN BEGIN "TWO WORD" THISWD ← THISWD & SP & THATWD ; RDENTITY ; END "TWO WORD" ;
PUTI(1, SYMNUM(THISWD)) ; PASS ;
IF ITSCH("(") THEN
BEGIN "FORMALS"
ROTTEN ← FALSE ; THISWD ← "," ; NAMES ← 0 ;
DO BEGIN
IF ITSCH(",") THEN DPASS
ELSE BEGIN WARN("=","Missed comma in macro formal list") ; ROTTEN←TRUE END ;
IF ITSCH(ε) THEN BEGIN DPASS ; NAME ← 0 ; END ELSE NAME ← 1 ;
IF ¬THISISID THEN BEGIN WARN("=","Formal parameters must be identifiers") ; ROTTEN←TRUE END
ELSE BEGIN PUTI(1, SYMB) ; NAMES ← 2*NAMES + NAME ; DPASS END ;
END
UNTIL ITSCH(")") ∨ ROTTEN ;
IF ITSCH(")") THEN PASS ;
END "FORMALS" ;
IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
ARGS ← IHIGH - SIHIGH - 1 ; BIND(DECLARE(ITBL[SIHIGH+1], MACROTYPE), MIX←PUSHI(MACROWDS,MACROTYPE)) ;
NUMARGS(MIX) ← ARGS ; ODDMAC(MIX) ← ODDONE ; BODY(MIX) ← PUSHS(1,DEFN(FALSE, FALSE,ARGS,SIHIGH+1)) ;
IHIGH ← SIHIGH ; NAMEPAR(MIX) ← NAMES ;
END "DMACRO" ;
SIMPLE PROCEDURE DMARGINS(BOOLEAN INWARD) ;
BEGIN
STRING S ; INTEGER L, R, W, ARIX, OLDIX, NEWIX ;
IF ON THEN DBREAK ;
ARIX ← IF AREAIXM THEN AREAIXM ELSE IXTEXT ; OLDIX ← MARGINS(ARIX) ; PASS ;
S ← IF THISTYPE > INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:) THEN NULL
ELSE E(NULL, NULL) ;
IF FULSTR(S) ∨ ITSCH(",") THEN
BEGIN "HAS PARAMS"
L ← IF FULSTR(S) THEN CVD(S) ELSE 0 ;
IF ITSCH(",") THEN BEGIN PASS ; R ← CVD(E("0",NULL)) END ELSE R ← 0 ;
IF ¬ON THEN RETURN ;
MARGINS(ARIX) ← NEWIX ← PUSHI(MARGWDS, MARGTYPE) ; W ← COLWID(ARIX) ;
LMARG ← (IF OLDIX THEN LMARGX(OLDIX) ELSE 0) + INWARD*L MAX 0 MIN W-1 ;
RMARG ← (IF OLDIX THEN RMARGX(OLDIX) ELSE W) - INWARD*R MIN W MAX LMARG+1 ;
LMARGX(NEWIX) ← LMARG ; RMARGX(NEWIX) ← RMARG ;
AREAX(NEWIX) ← ARIX ; OLD_MARGX(NEWIX) ← OLDIX ;
END "HAS PARAMS"
ELSE IF ¬ON THEN RETURN
ELSE IF OLDIX THEN
BEGIN "UNNEST"
AREAX(OLDIX) ← 0 ; comment, so ENDBLOCK won't use it ;
MARGINS(ARIX) ← NEWIX ← OLD_MARGX(OLDIX) ;
LMARG ← IF NEWIX THEN LMARGX(NEWIX) ELSE 0 ;
RMARG ← IF NEWIX THEN RMARGX(NEWIX) ELSE COLWID(ARIX) ;
IF OLDIX = IHED THEN IHED ← IHED - 1 - MARGWDS ;
END "UNNEST"
ELSE WARN("=","Extra "&(IF INWARD>0 THEN "NARROW" ELSE "WIDEN")&" in Margin Nest") ;
END "DMARGINS" ;
RECURSIVE PROCEDURE DNEXT ;
BEGIN
COMMENT Already PASSed "NEXT" ;
IF ¬THISISID ∨ (THISTYPE ≠ UNITTYPE ∧ THISTYPE ≠ PUNITTYPE) THEN WARN("=","NEXT what?")
ELSE IF ON THEN IF IX=IXPAGE THEN NEXTPAGE ELSE USTEP(SYMB, IX) ;
PASS ;
END "DNEXT" ;
SIMPLE PROCEDURE DPACK ;
BEGIN
END "DPACK" ;
SIMPLE PROCEDURE DPORTION ;
BEGIN
INTEGER CHAN, PIX ; STRING IFIL ; LABEL WASFWD ;
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed PORTION!") ; RETURN END ;
IF ¬ON THEN BEGIN PASS ; RETURN END ;
FINPORTION ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -2)) ;
PORSEQ(PIX) ← 0 ;
END
ELSE IF 0 ≤ (CHAN ← PORCH(PIX ← IX)) THEN BEGIN RELEASE(CHAN) ; PORCH(PIX) ← -3 ; GO TO WASFWD END
ELSE IF CHAN = -1 THEN BEGIN WARN("=","Can't declare PORTION FOOT!") ; PASS ; RETURN END
ELSE IF CHAN ≠ -5 THEN WARN("=","PORTION "&THISWD&" already declared!")
ELSE IF PORSEQ(THISPORT) ≠ PIX THEN
BEGIN PORCH(PIX) ← -2 ; COMMENT ADDED FEB 6, 1973 ;
WASFWD: BEGIN
IF INTER ≥ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) END ;
INTER ← SINTER ← -1 ;
END ;
END ;
IF INTER < 0 THEN
BEGIN
IFIL ← "PUI"&CVS(INTERS←INTERS+1) ;
PORINT(PIX)←CVASC(IFIL) ; INTER←WRITEON(TRUE,IFIL&".PUI") ; SINTER←WRITEON(FALSE,IFIL&"S.PUI") ;
END ;
IF PORSEQ(PIX) = 0 THEN
BEGIN
PORSEQ(SEQPORT) ← PIX ;
SEQPORT ← PIX ;
END ;
THISPORT ← PIX ; PORTS ← PORTS + 1 ;
PASS ;
END "DPORTION" ;
SIMPLE PROCEDURE DRECEIVE ;
BEGIN
STRING A ;
IF THATISCON ∧ 1≤ LENGTH(THATWD)-1 ≤2 THEN BEGIN PASS ; A ← THISWD[2 TO ∞] END
ELSE A ← NULL ;
IF ON THEN RECEIVE(THISPORT, A) ; PASS ;
END "DRECEIVE" ;
SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;
BEGIN
INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX ;
STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
SIMPLE PROCEDURE RESPREPL ;
BEGIN
RIX ← PUSHI(RESPWDS, RESPTYPE) ;
NEXT_RESP(RIX) ← LLPOST ; OLD_RESP(RIX) ← LLTHIS ;
END "RESPREPL" ;
ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
IF COMDWD = 1 THEN
BEGIN "AT"
PASS ;
IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
ELSE BEGIN
X ← SIMPAR ; L1 ← X ;
IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
ELSE IF THISWD[1 FOR 1]="0" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
TES 11/15/73: TEST ABOVE USED TO BE "0" LEQ L1 LEQ "9".
ALSO, TOOK OUT "PHRASE RESPONSE", VARI=0;
ELSE BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
DPASS ; A ← 0 ;
WHILE ¬(ITSCH(;) ∨ ITSCH(⊂)) DO
BEGIN
IF ¬THISISID THEN
BEGIN
WARN("=","Argument must be identifier.") ;
ROTTEN←TRUE ;
END ;
S←SYMB ; PASS ; IF LENGTH(X←SIMPAR)≠1 THEN WARN("=","Separator 1 character only");
PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
END ;
ARGS ← IHIGH - SIHIGH ;
END ;
END ;
END "AT"
ELSE BEGIN
PASS ; IF ¬THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/unit name") ; ROTTEN←TRUE END
ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
END ;
BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; RIX ← -1 ;
IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
X ← BOD ; SCAN(X, TO_NON_SP, HASBODY) ; IF ¬HASBODY THEN BOD ← NULL ;
CASE VARI-1 MIN 2 OF
BEGIN
ie 0... Phrase TES 11/15/73 removed this case ;
ie 1 ... Inset ;IF FINDINSET(CLU) THEN
IF DEPTH_RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT_RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN RIX ← LLTHIS
ELSE BEGIN
SSTK[BODY(LLTHIS)] ← NULL ; TES 11/15/73 ;
LLSKIP(LEADRESPS, NEXT_RESP)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(LEADRESPS,NEXT_RESP,RIX) ;
END ;
ie 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
IF FINDSIGNAL(SIG) THEN
BEGIN
S ← IF DEPTH_RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
IF S<0 THEN SSTK[BODY(LLTHIS)]←NULL; TES 11/15/73 ;
LLSKIP(SIGNALD[L1], NEXT_RESP) ; LLTHIS ← LLPOST ;
END ;
IF HASBODY ∨ S > 0 THEN
BEGIN
RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
LLINS(SIGNALD[L1], NEXT_RESP, RIX) ; RESP_SEP(RIX) ← A ;
IF S = 0 THEN SIG_BRC ← (SIG LSH -29) & SIG_BRC ; OLD_RESP(RIX) ← S MAX 0;
END ;
IF NULSTR(BOD) ∧ S THEN
BEGIN
X ← NULL ;
WHILE FULSTR(SIG_BRC) ∧ (A ← LOP(SIG_BRC)) ≠ L1 DO X ← X & A ;
SIG_BRC ← X & SIG_BRC ;
END ;
SETBREAK(TEXT_TBL, TEXT_BRC&SIG_BRC, NULL, "IS") ;
END ;
ie 3,4... AFTER/BEFORE area|unit ;
IF FINDTRAN(CLU, VARI) THEN
IF DEPTH_RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT_RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN RIX ← LLTHIS
ELSE BEGIN
SSTK[BODY(LLTHIS)] ← NULL ; TES 11/15/73 ;
LLSKIP(WAITRESP, NEXT_RESP)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(WAITRESP,NEXT_RESP,RIX) ;
END ;
END ;
IF RIX ≥ 0 THEN
BEGIN
CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
BODY(RIX) ← PUSHS(1,BOD) ; DEPTH_RESP(RIX) ← DEPTH ;
END ;
END "DRESPONSE" ;
SIMPLE PROCEDURE DREQUIRE ;
BEGIN
STRING F ;
PASS ; F ← E(NULL, "SOURCE!FILE") ;
IF ¬EQU(THISWD[1 TO 6],"SOURCE") THEN WARN("=","REQUIRE -- SOURCE_FILE only!") ;
IF FULSTR(F) ∧ ON THEN SWICHF(F) ; PASS ;
END "DREQUIRE" ;
SIMPLE PROCEDURE DSEND ;
BEGIN
INTEGER PIX; STRING FI ;
INTEGER SIMPLE PROCEDURE OPORT ;
BEGIN INTEGER CH ; CH←WRITEON(FALSE,(FI←(CVS(PORTS←PORTS+1)&THISWD)[1 TO 5])&".PUG"&JOBNO) ;
RETURN(CH) ; END "OPORT" ;
PASS ; IF ¬THISISID THEN BEGIN WARN("=","SEND Where?") ; RETURN END ;
IF ¬ON THEN BEGIN PASS ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, OPORT) ) ;
PORSEQ(PIX) ← 0 ; PORFIL(PIX) ← CVASC(FI) ;
END
ELSE IF PORCH(PIX←IX)=-5 THEN BEGIN PORCH(PIX)←OPORT ; PORFIL(PIX)←CVASC(FI) END ;
PASS ;
SEND(PIX, DEFN(TRUE,PORCH(PIX)≠-1,0,0)) ;
END "DSEND" ;
SIMPLE PROCEDURE DSHOW ;
BEGIN
END "DSHOW" ;
SIMPLE PROCEDURE DSUPERIMPOSE ;
BEGIN
INTEGER N ;
DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF ¬ON THEN RETURN ;
TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
END "DSUPERIMPOSE" ;
SIMPLE PROCEDURE DSKIP(BOOLEAN GRPSKIP) ;
BEGIN
BOOLEAN GM ;
DBREAK ; PASS ; IF GRPSKIP THEN BEGIN GM←GROUPM ; GROUPM ← GROUPM←1 ; END ;
IF ITS(TO) THEN
BEGIN "SKIP TO"
DAPART ; PASS ;
IF ITS(COLUMN) THEN BEGIN PASS; TOCOLUMN(CVD(E(CVS(COL+1),NULL))) END
ELSE BEGIN IF ITS(LINE) THEN PASS ; TOLINE(CVD(E("1", NULL))) END ;
END "SKIP TO"
ELSE SKIPLINES(IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:)
THEN 1 ELSE CVD(E("1", NULL))) ;
IF GRPSKIP ∧ GM = 0 THEN DAPART ;
END "DSKIP" ;
SIMPLE PROCEDURE DTABS ;
BEGIN
INTEGER NUMB, I ; BOOLEAN TOO ;
IF ON THEN TABSORT[1] ← TWO(33) ; TOO ← FALSE ;
DO BEGIN
PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
IF ON THEN
BEGIN
FOR I ← 1 THRU 27 DO IF TABSORT[I] ≥ NUMB THEN DONE ; IF I>27 THEN TOO←TRUE;
IF ¬TOO ∧ NUMB > -9999 THEN
IF TABSORT[I] > NUMB THEN DO BEGIN TABSORT[I] ↔ NUMB ; I ← I + 1 END UNTIL TABSORT[I-1]=TWO(33) ;
END ;
END
UNTIL ¬ITSCH(",") ;
IF TOO THEN WARN("=","Too many Tab Stops") ;
END "DTABS" ;
SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) ;
BEGIN
comment TURN ON|OFF {"c" [FOR "c"]},... ;
INTEGER C1, C2 ; STRING S1, S2 ;
PASS ;
IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(:) ∨ NEXTSCH(←) THEN
BEGIN "TURN BACK"
C1 ← IHED ;
WHILE C1>0 ∧ (C2←IXTYPE(C1))≠MODETYPE ∧ (C2≠TURNTYPE ∨ ISTK[C1-1]<0) DO C1 ← IXOLD(C1) ;
IF C2=TURNTYPE THEN DO BEGIN TURN((C2←ISTK[C1-1]) LSH -7,C2 LAND '177,1) ;
ISTK[C1-1] ← -2 ; C1 ← IXOLD(C1) END UNTIL C1≤0 ∨ IXTYPE(C1)≠TURNTYPE ∨ ISTK[C1-1]<0 ;
END "TURN BACK"
ELSE BEGIN "TURN CHARS"
PUSHI(TURNWDS, TURNTYPE) ; ISTK[IHED-1] ← -1 ;
DO BEGIN
IF ITSCH(",") THEN PASS ;
S1 ← IF NOT ITS(TAB) THEN SIMPAR ELSE TB ; PASS ;
COMMENT 2/27/73 TES ;
IF ITS(FOR) THEN BEGIN PASS ; S2 ← SIMPAR ; PASS END ELSE IF TURNON THEN S2 ← S1 ELSE S2 ← NULL ;
IF ON THEN
BEGIN
IF 0 ≠ LENGTH(S2) ≠ LENGTH(S1) THEN
WARN(NULL,"Strings each side of FOR are unequal length") ;
WHILE FULSTR(S1) DO
TURN(LOP(S1), IF FULSTR(S2) THEN LOP(S2) ELSE 0, TURNON) ;
END ;
END UNTIL ¬ITSCH(",") ;
END "TURN CHARS" ;
END "DTURN" ;
INTEGER SIMPLE PROCEDURE COUNTERSTMT ;
IF ITS(NEXT) THEN
BEGIN
INTEGER USYMB ; ie, unit name symbol number ;
PASS ; USYMB←IF THISTYPE=UNITTYPE THEN SYMB ELSE IF THISTYPE=PUNITTYPE THEN -SYMB ELSE TWO(20) ;
DNEXT ; RETURN(USYMB) ;
END
ELSE RETURN(0) ;
BOOLEAN SIMPLE PROCEDURE LABELDEF ;
IF ¬NEXTSCH(:) THEN RETURN(FALSE)
ELSE IF ¬ON THEN
BEGIN
WHILE THISISID ∧ NEXTSCH(:) DO BEGIN PASS ; PASS END ;
IF ¬ COUNTERSTMT THEN E(0, 0) ; RETURN(TRUE) ;
END
ELSE
BEGIN
INTEGER LINK, PTR, PLIGHT, USYMB, WASSYMB, VALPTR ; STRING DEFVAL ;
SIMPLE PROCEDURE CHECK_CONSISTENCY ;
IF WASSYMB ∧ USYMB≠0 ∧ LDB(IXN(WASSYMB)) ≠ LDB(IXN(ABS(USYMB))) THEN
WARN("=","Label "&SYM[LINK]&" was cross-referenced as a "&
SYM[WASSYMB]&" but is being defined as a "&
SYM[ABS(USYMB)]) ;
LINK ← 0 ;
DO BEGIN "MULTIPLE LABELS"
PTR ← SYMNUM(THISWD&":") ; BYTEWD ← NUMBER[PTR] ;
IF BYTEWD=0 OR ( PLIGHT ← LDB(PLIGHTWD(BYTEWD)) ) = 1 THEN
BEGIN NUMBER[PTR] ← BYTEWD LSH 13 LOR LINK ; LINK ← PTR END
ELSE WARN("=","Label "&SYM[PTR]&" is already defined as "&
(IF PLIGHT=2 THEN STBL[IX] ELSE "a recent page number")) ;
PASS ; PASS ;
END "MULTIPLE LABELS"
UNTIL ¬(THISISID ∧ NEXTSCH(:)) ;
DEFVAL ← IF (USYMB←COUNTERSTMT)=0 THEN E(0,0)
ELSE IF USYMB>TWO(13) THEN "??"
ELSE IF USYMB>0 THEN C! ELSE !;
IF EQU(DEFVAL,0) OR USYMB = SYMPAGE THEN
DO BEGIN "PAGE LABELS"
NUMBER[LINK] ↔ PLBL ; WASSYMB ← PLBL LSH -13 ;
CHECK_CONSISTENCY ;
PLBL ↔ LINK ; LINK ← LINK LAND '17777 ; PLBL ← -PLBL ;
END "PAGE LABELS"
UNTIL LINK=0
ELSE BEGIN "OTHER UNIT"
VALPTR ← 2 ROT -2 LOR PUTS(DEFVAL&(IF XCRIBL THEN ALTMODE&CVS(XLENGTH(DEFVAL)) ELSE NULL)) ;
DO BEGIN
PTR ← VALPTR ; NUMBER[LINK] ↔ PTR ; WASSYMB ← PTR LSH -13 ;
CHECK_CONSISTENCY ;
LINK ← PTR LAND '17777 ;
END
UNTIL LINK=0 ;
END "OTHER UNIT" ;
RETURN(TRUE) ;
END "LABELDEF" ;
RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT ;
IF NEXTSCH(←) THEN
BEGIN
VASSIGN(SYMB, THISTYPE, IX, E(SPASS(PASS), 0)) ;
IF ITSCH(;) THEN PASS ; RETURN(TRUE) ;
END
ELSE RETURN(FALSE) ;
BOOLEAN SIMPLE PROCEDURE EMPTYCHUNK ;
RETURN(IF ITSCH(;) THEN IPASS(TRUE) ELSE FALSE) ;
BOOLEAN SIMPLE PROCEDURE NONSENSE(BOOLEAN VALID) ;
BEGIN
IF VALID THEN WARN("=","Can't make sense out of: "&SOMEINPUT) ;
PASS ; RETURN(FALSE) ;
END "NONSENSE" ;
RECURSIVE BOOLEAN PROCEDURE COMMAND ;
BEGIN
DEFINE DB(WHAT) = "BEGIN IF ON THEN WHAT; PASS END",
BDB(WHAT)="BEGIN IF ON THEN BEGIN DBREAK; WHAT END; PASS END";
IF THATISID ∧ SYMLOOK(THISWD&THATWD) ∧ LDB(TYPEN(SYMBOL))=MANTYPE THEN
BEGIN THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MANTYPE ;
IX ← LDB(IXN(SYMB)) ; RDENTITY ; END
ELSE IF THISTYPE ≠ MANTYPE THEN RETURN(FALSE) ;
CASE IX OF
BEGIN COMMENT COMMANDS ; comment THISWD is command word.;
ie ADJUST ; BDB(JUSTM←1) ;
ie AFTER ; DRESPONSE(2) ;
ie APART ; BEGIN DAPART ; PASS END ;
ie AREA ; DAREA(FALSE) ;
ie AT ; DRESPONSE(1) ;
ie BEFORE ; DRESPONSE(0) ;
ie BEGIN ; BEGIN BEGINBLOCK(FALSE, IF ENDCASE=2 ∧ ON THEN -1 ELSE 1,
IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END ;
ie BELOW ; DBELOW ;
ie BLANK PAGE ; DBLANKPAGE ;
ie BOX FRAME ; DFRAME(TRUE) ;
ie BREAK ; BEGIN DBREAK ; PASS END ;
ie CC ; DCC ;
ie CENTER ; BDB(BREAKM←4) ;
ie CLOSE ; DCLOSE ;
ie COMMAND CHARACTER ; DCOMMANDCHARACTER ;
ie COMMENT ; BEGIN IMPOSSIBLE("COMMAND") ; PASS END ;
ie COMPACT ; DB(SPACEM←IF FILL THEN 1 ELSE 2) ;
ie CONTINUE ; BEGIN DBREAK ; NOPGPH ← 1 ; PASS END ;
ie COUNT ; DCOUNT ;
ie CRBREAK ; DB(CRBM←1) ;
ie CRSPACE ; DB(CRBM←0) ;
ie DEVICE ; DDEVICE ;
ie END ; CASE IF STARTS THEN 0 ELSE ENDCASE OF BEGIN STARTEND; BEGINEND; ONCEEND; RESPEND END ;
ie FILL ; BDB(BREAKM ← 0 ; SPACEM ← SPACEM MIN 1) ;
ie FLUSH LEFT ; BDB(BREAKM←2) ;
ie FLUSH RIGHT ; BDB(BREAKM←3) ;
ie FONT ; DFONT(FALSE);
ie GROUP ; IF GROUPM THEN PASS ELSE BDB(GROUPM←1) ;
ie GROUP SKIP ; DSKIP(TRUE) ;
ie IF ; DCONDITIONAL ;
ie INDENT ; DINDENT ;
ie INSERT ; DINSERT ;
ie JUSTJUST ; BDB(BREAKM←1) ;
ie LET ; DLET ;
ie LOCK ; DLOCK ;
ie MACRO ; DMACRO(1) ;
ie NARROW ; DMARGINS(1) ; COMMENT SEMI-OBSOLETE ;
ie NEXT ; BEGIN PASS ; DNEXT END ;
ie NOFILL ; BDB(BREAKM←7) ;
ie NOJUST ; BDB(JUSTM←0) ;
ie ONCE ; BEGIN IF ON∧ENDCASE≠2 THEN BEGIN INTEGER S ; S ← STARTS ; STARTS ← 0 ;
BEGINBLOCK(FALSE,2,ALTMODE) ; STARTS ← S ; END ; PASS END ;
ie PACK ; DPACK ;
ie PAGE FRAME ; DFRAME(FALSE) ;
ie PLACE ; BEGIN IF ON THEN DBREAK ; PASS ; PLACE(IX) ; PASS END ;
ie PORTION ; DPORTION ;
ie PREFACE ; BEGIN DBREAK; PASS; K←CVD(E("0",NULL)); IF ON THEN IF FILL THEN LEADFM←K ELSE LEADNM←K END ;
ie RECEIVE ; DRECEIVE ;
ie RECURSIVE MACRO ; DMACRO(0) ;
ie REQUIRE ; DREQUIRE ;
ie RETAIN ; DB(SPACEM←0) ;
ie SELECT ; DFONT(TRUE) ;
ie SEND ; DSEND ;
ie SHOW ; DSHOW ;
ie SKIP ; DSKIP(FALSE) ;
ie START ; BEGIN BEGINBLOCK(FALSE,0,IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END;
ie SUPERIMPOSE ; DSUPERIMPOSE ;
ie TABS ; DTABS ;
ie TEXT AREA ; DAREA(FALSE) ;
ie TITLE AREA ; DAREA(TRUE) ;
ie TURN OFF ; DTURN(0) ;
ie TURN ON ; DTURN(-1) ;
ie VARIABLE ; DLOCAL ;
ie VERBATIM ; BDB(BREAKM←6) ;
ie WIDEN ; DMARGINS(-1) ; COMMENT SEMI-OBSOLETE ;
END ; COMMENT COMMANDS ;
IF ITSCH(;) THEN PASS ;
RETURN(TRUE) ;
END ;
INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
BEGIN
IF PAGEMARKS > PAGEWAS THEN
BEGIN comment, might be AT PAGEMARK response ;
FOR PAGEWAS ← PAGEWAS + 1 THRU PAGEMARKS DO IF SIGNALD[FF] THEN RESPOND(SIGNALD[FF]) ;
PAGEWAS ← PAGEMARKS ;
END ;
RETURN(THISISID AND (ASSIGNMENT OR LABELDEF OR COMMAND) OR TEXTLINE OR EMPTYCHUNK OR NONSENSE(VALID)) ;
END "CHUNK" ;
INTERNAL SIMPLE PROCEDURE MANUSCRIPT ;
BEGIN
BOOLEAN VALID ;
VALID ← TRUE ;
DO VALID ← CHUNK(VALID) UNTIL LAST < 1 ;
IF ¬NEXTS(7!MANUSCRIPT) THEN WARN("=","BRACKETS DON'T PAIR UP!!!!!!!!!") ;
FINPORTION ; IF BLNMS=0 THEN BEGINEND ELSE IF BLNMS>0 THEN
WARN("=",CVS(BLNMS) & " EXTRA BEGIN'S AND STARTS") ;
END "MANUSCRIPT" ;
END "INNER BLOCK" ;
END "PARSER"